load packages
library(tidyverse)
library(knitr)
define variables
# paths
outputDir = '/Volumes/psych-cog/dsnlab/auto-motion-output/'
# variables
study = "tds"
load data
# global intensity file created using calculate_global_intensities.R
trash = read.csv(paste0(outputDir,study,'_autoTrash.csv'))
# manually coded file created using manually_coded.R
manual = read.csv(paste0(outputDir,study,'_manuallyCoded.csv'))
# afni 3dToutCount outlier created using merge_outcount.R
outcount = read.csv(paste0(outputDir,study,'_outcount.csv')) %>%
filter(poly == "p2") %>%
mutate(trashOut = ifelse(outliers > .075, 1, 0))
compare to manual data
# filter trash dataframe and join with filteredMotion
joined = trash %>%
left_join(., manual, by = c("subjectID","run","volume")) %>%
left_join(., outcount, by = c("subjectID","run","volume")) %>%
select(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash) %>%
mutate(auto = ifelse(trashDiff == 1 & trash == 1, 2,
ifelse(trashDiff == 1 & trash == 0, 3, trash)),
outcount = ifelse(trashOut == 1 & trash == 1, 2,
ifelse(trashOut == 1 & trash == 0, 3, trash))) %>%
gather(compare, code, -c(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash))
# check false negatives
falseNeg.auto = joined %>% filter(trashDiff == 0 & trash == 1)
falseNeg.outcount = joined %>% filter(trashOut == 0 & trash == 1)
# check false positives
falsePos.auto = joined %>% filter(trashDiff == 1 & trash == 0)
falsePos.outcount = joined %>% filter(trashOut == 1 & trash == 0)
# check hits
hits.auto = joined %>% filter(trashDiff == 1 & trash == 1)
hits.outcount = joined %>% filter(trashOut == 1 & trash == 1)
summarize results
print group-level results
table = data.frame(falseNeg = c(length(falseNeg.auto$trash),length(falseNeg.outcount$trash)),
falsePos = c(length(falsePos.auto$trash),length(falsePos.outcount$trash)),
hits = c(length(hits.auto$trash),length(hits.outcount$trash)))
row.names(table)=c("auto","outcount")
kable(table,format = "pandoc")
| auto |
142 |
526 |
434 |
| outcount |
212 |
160 |
368 |
summarize by participants
nVol = joined %>% group_by(subjectID) %>% summarize(nVol = length(volume))
summaryPos = falsePos.auto %>% group_by(subjectID) %>% summarize(falsePos = sum(trashDiff, na.rm=T))
summaryNeg = falseNeg.auto %>% group_by(subjectID) %>% summarize(falseNeg = sum(trash, na.rm=T))
summaryPosNeg = nVol %>%
full_join(., summaryPos, by = "subjectID") %>%
full_join(., summaryNeg, by = "subjectID") %>%
mutate(falseNeg = ifelse(is.na(falseNeg), 0, falseNeg),
falsePos = ifelse(is.na(falsePos), 0, falsePos),
totalErrors = falsePos + falseNeg,
percentErrors = (totalErrors/nVol)*100)
print subject-level results
joined %>% group_by(subjectID) %>%
summarise(trashManual = sum(trash, na.rm = T),
trashAuto = sum(trashDiff, na.rm = T)) %>%
full_join(., summaryPosNeg, by = "subjectID") %>%
select(-nVol) %>%
arrange(trashManual) %>%
kable(format = "pandoc", digits = 1)
| t105 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t106 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t109 |
0 |
4 |
4 |
0 |
4 |
0.3 |
| t110 |
0 |
4 |
4 |
0 |
4 |
0.3 |
| t111 |
0 |
2 |
2 |
0 |
2 |
0.1 |
| t114 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t115 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t125 |
0 |
4 |
4 |
0 |
4 |
0.3 |
| t126 |
0 |
4 |
4 |
0 |
4 |
0.3 |
| t127 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t128 |
0 |
4 |
4 |
0 |
4 |
0.3 |
| t131 |
0 |
20 |
20 |
0 |
20 |
1.4 |
| t132 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t133 |
0 |
4 |
4 |
0 |
4 |
0.3 |
| t135 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t136 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t137 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t140 |
0 |
0 |
0 |
0 |
0 |
0.0 |
| t120 |
2 |
6 |
4 |
0 |
4 |
0.3 |
| t124 |
2 |
4 |
4 |
2 |
6 |
0.4 |
| t108 |
4 |
10 |
8 |
2 |
10 |
0.7 |
| t117 |
4 |
14 |
10 |
0 |
10 |
0.7 |
| t104 |
6 |
14 |
10 |
2 |
12 |
0.8 |
| t122 |
6 |
4 |
0 |
2 |
2 |
0.1 |
| t101 |
14 |
52 |
42 |
4 |
46 |
3.0 |
| t130 |
16 |
14 |
14 |
16 |
30 |
2.0 |
| t129 |
32 |
62 |
34 |
4 |
38 |
2.6 |
| t121 |
42 |
58 |
26 |
10 |
36 |
2.4 |
| t113 |
52 |
88 |
52 |
14 |
66 |
4.5 |
| t119 |
52 |
64 |
24 |
12 |
36 |
2.4 |
| t134 |
66 |
88 |
36 |
12 |
48 |
3.2 |
| t102 |
82 |
158 |
76 |
0 |
76 |
4.6 |
| t116 |
84 |
136 |
86 |
32 |
118 |
8.1 |
| t139 |
120 |
142 |
54 |
30 |
84 |
5.6 |
# visualize for each subject subject
joined.plot = joined %>% mutate(code = as.factor(code)) %>%
select(subjectID, run, volume, volMean, volSD, compare, code) %>%
gather(measure, value, -c(subjectID, run, compare, volume, code))
nada = joined.plot %>% group_by(subjectID) %>%
do({
plot = ggplot(., aes(volume, value)) +
geom_point(aes(color = code)) +
geom_line() +
facet_grid(measure + compare ~ run, scales= "free") +
scale_colour_hue(drop = FALSE) +
scale_colour_discrete(labels=c("not trash", "false neg", "hit", "false pos")) +
labs(title = .$subjectID[[1]])
print(plot)
#ggsave(plot, file=paste0(outputDir,'plots/',.$subjectID[[1]],'.png'), width = 12)
data.frame()
})












